home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / OGRID110 / GLVIEWS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-01  |  13KB  |  435 lines

  1. {********************************************************************
  2.  
  3.   OOGrid Library(TM) for Borland/Turbo Pascal (Real Mode/TV)
  4.   Copyright (C) 1994, 1995 by Arturo J. Monge
  5.   Portions Copyright (C) 1989,1990 Borland International, Inc.
  6.  
  7.   OOGrid Library(TM) Views Unit:
  8.     Implements three TView's descendants used by the TSpreadSheet object
  9.     and also defines the record variables used by the SetData and GetData
  10.     methods of the dialogs used by TSpreadSheet.
  11.  
  12.   Copyright (C) 1994 by Arturo J. Monge
  13.  
  14.   Last Modification : December 29th, 1994
  15.  
  16. *********************************************************************}
  17.  
  18. unit GLViews;
  19.  
  20. {****************************************************************************}
  21.                                  interface
  22. {****************************************************************************}
  23.  
  24. uses Objects, Dialogs, Drivers, Views, GLEquate;
  25.  
  26. type
  27.  
  28.   PSheetInputLine = ^TSheetInputLine;
  29.   TSheetInputLine = OBJECT(TInputLine)
  30.   { An input line that can be inserted in a TSpreadSheetWindow object in
  31.     modal state.  It maps to the color palette of the TSpreadsheetWindow
  32.     object and handles kbEnter, kbEsc, kbUp and kbDown by ending the modal
  33.     state of the view }
  34.       EndState : Word;
  35.     constructor Init(AMaxLen: Integer);
  36.     procedure EndModal(Command: Word); virtual;
  37.     function Execute: Word; virtual;
  38.     function GetPalette: PPalette; virtual;
  39.     procedure HandleEvent(var Event: TEvent); virtual;
  40.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  41.   end; {...TSheetInputLine }
  42.  
  43. const
  44.  
  45. { TSheetInputLine palette }
  46.  
  47.   CSheetInputLine = #9#9#10#11;
  48.  
  49. { CSheetInputLine palette layout }
  50.  
  51.   { 1 = Passive }
  52.   { 2 = Active }
  53.   { 3 = Arrow }
  54.   { 4 = Selected }
  55.  
  56. type
  57.  
  58.   PLimScrollBar = ^TLimScrollBar;
  59.   TLimScrollBar = object(TScrollBar)
  60.   { A TScrollBar's descendant that allows the definition of a display subrange.
  61.     This is particularly useful if the TScroller object that owns the
  62.     scrollbar has a very broad scrolling range (for example, 32767 columns).
  63.     In this case, a normal TScrollBar object would be of no use at all,
  64.     because one click in an arrow would move the scroller more than 1000
  65.     columns. TLimScrollBar lets you define a smaller scrolling range, making
  66.     it more useful than a TScrollBar }
  67.       OldValue     : Word;
  68.       DisplayLimit : Word;
  69.     constructor Init(var Bounds: TRect; ADisplayLimit: Integer);
  70.     function Change: Integer;
  71.     procedure Draw; virtual;
  72.     procedure HandleEvent(var Event: TEvent); virtual;
  73.     constructor Load(var S: TStream);
  74.     procedure Store(var S: TStream);
  75.   end; {...TLimScrollBar }
  76.  
  77.  
  78.   PMessageLine = ^TMessageLine;
  79.   TMessageLine = object(TView)
  80.   { Displays the string stored in the StatusMessage attribute.  This object
  81.     is used to display status line messages }
  82.       StatusMessage : String[79];
  83.     constructor Init (Bounds:TRect; AMessage:String);
  84.     procedure Draw; virtual;
  85.   end; {...TMessageLine }
  86.  
  87. var
  88.   MessageLine : PMessageLine;
  89.   { Global variable used to display messages at the bottom of the screen }
  90.  
  91. var
  92.  
  93. { Global record-type variables used with the GetData and SetData methods
  94.   of TSpreadsheet's dialogs }
  95.  
  96.   RChangeHeader : record
  97.   { Used by the ChangeHeader dialog }
  98.     NewHeader : String[80]; {Inputline}
  99.   end; {...RChangeHeader }
  100.  
  101.   RChangeWidth : record
  102.   { Used by the ChangeWidth dialog }
  103.     NewWidth : String[10]; {Inputline}
  104.   end; {...RChangeWidth }
  105.  
  106.   RFormat : record
  107.   { Used by the FormatCell dialog }
  108.     Justification : Word; {RadioButtons}
  109.     DecimalPlaces : String[1]; {Inputline}
  110.     CurrencyChar : String[1]; {Inputline}
  111.     NumberFormat : Word; {Checkboxes}
  112.   end; {...RFormat }
  113.  
  114.   RGoToCell : record
  115.   { Used by the GoTo dialog }
  116.     NewCell : String[10]; {Inputline}
  117.   end; {...RGoToCell }
  118.  
  119.   RCopyFormulas : record
  120.   { Used by the CopyFormulas dialog }
  121.     CopyFormulas : Word; {Checkboxes}
  122.   end; {...RCopyFormulas }
  123.  
  124.   RPrint : record
  125.   { Used by the Print dialog }
  126.     PrintTo : Word; {RadioButtons}
  127.     PrintSize : Word; {RadioButtons}
  128.     PrintRows : Word; {RadioButtons}
  129.     PrintColumns : Word; {RadioButtons}
  130.     TopMargin : String[3]; {Inputline}
  131.     BottomMargin : String[3]; {Inputline}
  132.     LeftMargin : String[3]; {Inputline}
  133.     RightMargin : String[3]; {Inputline}
  134.     Other : Word; {Checkboxes}
  135.     PageRows : String[3]; {Inputline}
  136.     NormalCols : String[3]; {Inputline}
  137.     CondensedCols : String[3]; {Inputline}
  138.   end; {...RPrint }
  139.  
  140.   RSortInfo : record
  141.   { Used by the Sort dialog }
  142.     FirstKey : String[80]; {Inputline}
  143.     FirstKeyOrder : Word; {RadioButtons}
  144.     SecondKey : String[80]; {Inputline}
  145.     SecondKeyOrder : Word; {RadioButtons}
  146.     ThirdKey : String[80]; {Inputline}
  147.     ThirdKeyOrder : Word; {RadioButtons}
  148.   end; {...RSortInfo }
  149.  
  150. function DisplayMessage (AMessage:String): Boolean;
  151. { Displays a message at the bottom of the screen }
  152. procedure EraseMessage;
  153. { Erases a message that was displayed using DisplayMessage }
  154. procedure RegisterGLViews;
  155. { Register the unit's objects }
  156.  
  157. const
  158.   RLimScrollBar : TStreamRec = (
  159.      ObjType : stRLimScrollBar;
  160.      VmtLink : Ofs(TypeOf(TLimScrollBar)^);
  161.      Load    : @TLimScrollBar.Load;
  162.      Store   : @TLimScrollBar.Store
  163.   );
  164.  
  165.   RSheetInputLine : TStreamRec = (
  166.      ObjType : stRSheetInputLine;
  167.      VmtLink : Ofs(TypeOf(TSheetInputLine)^);
  168.      Load    : @TSheetInputLine.Load;
  169.      Store   : @TSheetInputLine.Store
  170.   );
  171.  
  172. {****************************************************************************}
  173.                                implementation
  174. {****************************************************************************}
  175.  
  176. uses App;
  177.  
  178. {** Unit's Register procedures **}
  179.  
  180. procedure RegisterGlViews;
  181. begin
  182.   RegisterType(RLimScrollBar);
  183.   RegisterType(RSheetInputLine);
  184. end; {...RegisterGLViews }
  185.  
  186.  
  187. {** DisplayMessage function **}
  188.  
  189. function DisplayMessage (AMessage:String): Boolean;
  190. var
  191.   R : TRect;
  192. begin
  193.   DisplayMessage := False;
  194.   Application^.GetExtent(R);
  195.   R.A.Y := R.B.Y - 1;
  196.   if MessageLine <> NIL then
  197.     begin
  198.       MessageLine^.StatusMessage := ' ' + AMessage;
  199.       MessageLine^.Draw;
  200.     end {...if MessageLine <> NIL }
  201.   else
  202.     begin
  203.       MessageLine := New(PMessageLine, Init(R, AMessage));
  204.       if MessageLine^.Valid(cmValid) = True then
  205.         begin
  206.           Application^.Insert(MessageLine);
  207.           DisplayMessage := True;
  208.         end {...if MessageLine^.Valid(cmValid) = True }
  209.       else
  210.         MessageLine := NIL;
  211.     end; {...if/else }
  212. end; {...DisplayMessage }
  213.  
  214.  
  215. {** EraseMessage procedure **}
  216.  
  217. procedure EraseMessage;
  218. begin
  219.   if MessageLine <> NIL then
  220.     Dispose(MessageLine , Done);
  221.   MessageLine := NIL;
  222. end; {...EraseMessage }
  223.  
  224.  
  225. {** TLimScrollBar **}
  226.  
  227. constructor TLimScrollBar.Init(var Bounds: TRect; ADisplayLimit: Integer);
  228. begin
  229.   TScrollBar.Init(Bounds);
  230.   DisplayLimit := ADisplayLimit;
  231. end; {...TLimScrollBar.Init }
  232.  
  233. function TLimScrollBar.Change: Integer;
  234. { Returns the amount of change in the scrollbar position }
  235. begin
  236.   Change := Value - OldValue;
  237. end; {...TLimScrollBar.Change }
  238.  
  239. procedure TLimScrollBar.Draw;
  240. { Draws the scrollbar using a virtual max value }
  241. var
  242.   RealMax   : Integer;
  243.   RealValue : Word;
  244. begin
  245.   RealMax := Max;
  246.   RealValue := Value;
  247.   Max := DisplayLimit;
  248.   If Value > DisplayLimit then
  249.     Value := DisplayLimit;
  250.   TScrollBar.Draw;
  251.   Max := RealMax;
  252.   Value := RealValue;
  253. end; {...TLimScrollBar.Draw }
  254.  
  255. procedure TLimScrollBar.HandleEvent(var Event: TEvent);
  256. var
  257.   Mouse       : TPoint;
  258.   MousePos    : Byte;
  259.   BarSize     : Byte;
  260.   RealValue   : Word;
  261.   RealMax     : Integer;
  262.   SendChanged : Boolean;
  263.  
  264.     function GetMouseRelativePos(MousePos, Size: Byte): Integer;
  265.     var
  266.       MousePoint : Real;
  267.     begin
  268.       MousePoint := (DisplayLimit / (Size - 3)) * MousePos;
  269.       GetMouseRelativePos := Trunc(MousePoint);
  270.     end; {...GetMouseRelativePos }
  271.  
  272. begin
  273.   OldValue := Value;
  274.   if Event.What = evMouseDown then
  275.   begin
  276.     if MouseInView(Event.Where) then
  277.     begin
  278.       MakeLocal(Event.Where, Mouse);
  279.       if ((Mouse.X <> 0) and (Mouse.X < Pred(Size.X))) or
  280.          ((Mouse.Y <> 0) and (Mouse.Y < Pred(Size.Y))) then
  281.         begin
  282.           if Mouse.Y = 0 then
  283.             begin
  284.               MousePos := Mouse.X;
  285.               BarSize := Size.X;
  286.             end {...if Mouse.Y = 0 }
  287.           else
  288.             begin
  289.               MousePos := Mouse.Y;
  290.               BarSize := Size.Y;
  291.             end; {...if/else }
  292.           RealValue := Value;
  293.           RealMax := Max;
  294.           Max := DisplayLimit;
  295.           if (Value > DisplayLimit) and
  296.              (GetMouseRelativePos(MousePos, BarSize) >= DisplayLimit) then
  297.             begin
  298.               Value := DisplayLimit;
  299.               TScrollBar.HandleEvent(Event);
  300.               if (Value = DisplayLimit) and
  301.                  (RealValue > DisplayLimit) then
  302.               begin
  303.                 DrawView;
  304.                 Message (Owner, evBroadCast, cmScrollBarChanged, @Self);
  305.               end; {...if (Value = DisplayLimit) and ... }
  306.             end {...if (Value > DisplayLimit) and ... }
  307.           else if (Value > DisplayLimit) then
  308.             begin
  309.               repeat
  310.                 if Value <= PgStep then
  311.                   Value := 1
  312.                 else
  313.                   Value := Value - PgStep;
  314.                 DrawView;
  315.                 Message (Owner, evBroadCast, cmScrollBarChanged, @Self);
  316.               until (not MouseEvent(Event, evMouseAuto)) or (Value = 1);
  317.             end {...else if (Value > DisplayLimit) }
  318.           else
  319.             TScrollbar.HandleEvent(Event);
  320.             Max := RealMax;
  321.         end {...if ((Mouse.X <> 0) and (Mouse.X < Pred(Size.X))) or ... }
  322.       else
  323.         TScrollBar.HandleEvent(Event);
  324.     end; {...if MouseInView(Event.Where) }
  325.   end; {...if Event.What = evMouseDown }
  326. end; {...TLimScrollBar.HandleEvent }
  327.  
  328.  
  329. constructor TLimScrollBar.Load(var S: TStream);
  330. { Reads the object from a stream }
  331. begin
  332.    TScrollBar.Load(S);
  333.    S.Read(OldValue, SizeOf(OldValue));
  334.    S.Read(DisplayLimit, SizeOf(DisplayLimit));
  335. end; {...TLimScrollBar.Load }
  336.  
  337.  
  338. procedure TLimScrollBar.Store(var S: TStream);
  339. { Writes the object to a stream }
  340. begin
  341.    TScrollBar.Store(S);
  342.    S.Write(OldValue, SizeOf(OldValue));
  343.    S.Write(DisplayLimit, SizeOf(DisplayLimit));
  344. end; {...TLimScrollBar.Store }
  345.  
  346.  
  347. {** TMessageLine **}
  348.  
  349. constructor TMessageLine.Init(Bounds:TRect; AMessage:String);
  350. begin
  351.   TView.Init(Bounds);
  352.   StatusMessage := ' '+AMessage;
  353. end; {...TMessageLine.Init }
  354.  
  355. procedure TMessageLine.Draw;
  356. { Displays the message within the bounds of the view using the color in
  357.   the 2nd entry of the application's palette (Normal Text) }
  358. var
  359.   B : TDrawBuffer;
  360.   C : Byte;
  361. begin
  362.   C := GetColor(2);
  363.   MoveChar(B, ' ', C, Size.X);
  364.   MoveStr(B, StatusMessage, C);
  365.   WriteLine(0, 0, Size.X, 1, B);
  366. end; {...TMessageLine.Draw }
  367.  
  368.  
  369. {** TSheetInputLine **}
  370.  
  371. constructor TSheetInputLine.Init(AMaxLen: Integer);
  372. var
  373.   R : TRect;
  374. begin
  375.   R.Assign(0,0,0,0);
  376.   TInputLine.Init(R, AMaxLen);
  377. end; {...TSheetInputLine.Init }
  378.  
  379. procedure TSheetInputLine.EndModal(Command: Word);
  380. begin
  381.   EndState := Command;
  382. end; {...TSheetInputLine.EndModal }
  383.  
  384. function TSheetInputLine.Execute: Word;
  385. { Allows modal execution of the inputline }
  386. var
  387.   E: TEvent;
  388. begin
  389.   EndState := 0;
  390.   repeat
  391.     GetEvent(E);
  392.     HandleEvent(E);
  393.   until EndState <> 0;
  394.   Execute := EndState;
  395. end; {...TSheetInputLine.Execute }
  396.  
  397. function TSheetInputLine.GetPalette: PPalette;
  398. const
  399.   NewPalette : string[Length(CSheetInputLine)] = CSheetInputLine;
  400. begin
  401.   GetPalette := @NewPalette;
  402. end; {...TSheetInputLine.GetPalette }
  403.  
  404. procedure TSheetInputLine.HandleEvent(var Event: TEvent);
  405. var
  406.   EmptyString : String;
  407. begin
  408.   TInputLine.HandleEvent(Event);
  409.   case Event.What of
  410.     evKeyDown :
  411.     begin
  412.       case Event.KeyCode of
  413.         kbEnter, kbUp, kbDown : EndModal(cmOk);
  414.         kbEsc   :
  415.           begin
  416.             EmptyString := '';
  417.             SetData(EmptyString);
  418.             EndModal(cmCancel);
  419.           end; {...case Event.KeyCode of kbEsc }
  420.       end; {...case Event.KeyCode }
  421.       ClearEvent(Event);
  422.     end; {...case Event.What of evKeyDown }
  423.   end; {...case Event.What }
  424. end; {...TSheetInputLine.HandleEvent }
  425.  
  426. procedure TSheetInputLine.SetState(AState: Word; Enable: Boolean);
  427. begin
  428.   TView.SetState(AState, Enable);
  429.   DrawView;
  430. end; {...TSheetInputLine.SetState }
  431.  
  432. begin
  433.   MessageLine := NIL;
  434. end. {...TSViews unit }
  435.